-----------------------------------------------------------------------------
-- |
-- Module      : LLVM.Parser.Record.Struct
-- Copyright   : Mikhail Belyaev
-- License     : GPLv3 (see LICENSE)
--
-- Structure bindings and ways to work with them
-----------------------------------------------------------------------------

module LLVM.Parser.Record.Struct
       (
         StructBindings,
         defaultBinds,
         getRecord
       )
where

import LLVM.Util
import LLVM.Parser.Bits.BitGet
import LLVM.Parser.Bits.Primitives
import LLVM.Parser.Bits.Struct
import LLVM.Parser.Record.Record

import Control.Monad

import qualified Data.ByteString as B
import qualified Data.Map as Map

-- record examples
-- block entry
blockStart = [
                -- Const (Prim (Integral (FBR 2))) (IntVal cENTER_SUBBLOCK),
                Prim $ Integral $ VBR 8, -- BLOCK ID
                Prim $ Integral $ VBR 4, -- Abbrev len
                Prim Align32,
                Prim . Integral $ FBR 32 -- block size/4
             ]
-- block exit
blockEnd = [
                -- Const (Prim (Integral (FBR 2))) (IntVal cEND_BLOCK),
                Prim Align32
           ]
-- unnabbr record
unabbreviated = [
                     Prim $ Integral $ VBR 6, -- code
                     Arr (VBR 6) -- numops
                         (Prim $ Integral $ VBR 6) -- each op
                ]


-- get element by opcode in abbreviation def
defineOp :: FieldVal -> MayError StructElem
defineOp key =
               case key of
                    IntVal 1 -> meSucceed $ Prim $ Integral $ VBR 8 -- literal operand
                    IntVal 0 -> meSucceed $ Variable (Prim $ Integral $ FBR 3) defineEncoding
                    IntVal x -> meFail $ "Unknown key used in abbreviation def:" ++ show x
                    _ -> meFail "defineOp func is used outside context: key parameter is non-integer"

-- get element by encoding in abbreviation def
defineEncoding :: FieldVal -> MayError StructElem
defineEncoding tp =
               case tp of
                    IntVal 1 -> meSucceed $ Prim $ Integral $ VBR 5
                    IntVal 2 -> meSucceed $ Prim $ Integral $ VBR 5
                    IntVal 3 -> meSucceed $ VoidElem
                    IntVal 4 -> meSucceed $ VoidElem
                    IntVal 5 -> meSucceed $ VoidElem
                    IntVal x -> meFail $ "Unknown opcode used in abbreviation def:" ++ show x
                    _ -> meFail "defineEncoding func is used outside context: opcode parameter is non-integer"
-- abbreviation definition is a complex type of record
defineAbbrev = [
                     Arr (VBR 5) -- numops
                         (Variable (Prim $ Integral $ FBR 1) defineOp)
                ]

-- Structural bindings are just a dict mapping id integers to record structures
type StructBindings = Map.Map Integer [StructElem]

-- default value for bindings
defaultBinds :: StructBindings
defaultBinds = Map.fromList
               [
                   (cENTER_SUBBLOCK, blockStart),
                   (cEND_BLOCK, blockEnd),
                   (cDEFINE_ABBREV, defineAbbrev),
                   (cUNABBREV_RECORD, unabbreviated)
               ]

-- fetch a value from a fieldval
-- get an error if the val is not integral
fetchInteger :: FieldVal -> MayError Integer
fetchInteger a = maybe2mayerror
                        (integerValueOf a)
                        "Do not use fetchInteger with anything besides IntVal"

-- read a record with given id and bindings
-- all types of erros can occur
getRecord :: Int -> StructBindings -> ErrBitGet RawRecord
getRecord idlen bindings = do
                               idd <- getPField $ Integral $ FBR idlen
                               id'' <- promoteError $ fetchInteger idd
                               bind <- promoteMaybe
                                                (id'' `Map.lookup` bindings)
                                                ("Requested id not found in bindings:" ++ show id'')
                               ddata <- getFields bind
                               return $ RawRecord id'' ddata
